home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
bbsutil
/
dlx70bbs.zip
/
DLX70SRC.ZIP
/
FS_PKG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-19
|
6KB
|
224 lines
{$debug-}
{$line-}
{$include: 'types.int'}
{$include: 'globals.int'}
{$include: 'utils.int'}
{$include: 'fs_pkg.int'}
IMPLEMENTATION OF fs_pkg;
USES types,globals,utils;
{DLX Bulletin Board System V7.0
FREEWARE NOTICE
DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
Anyone who wishes to may run the program, copy it, or modify it for
any purpose, including commercial gain.}
{***Interface to the PASASM assembler utilities package***}
{$include: 'pasasm.int'}
const
cr = chr(13); {carriage return}
lf = chr(10); {linefeed}
ctrlz = chr(26); {old style eof}
ioblen = 256; {i/o buffer length in bytes}
type
text_file = record
buffer : array [1..ioblen] of char; {readln info}
ngood : integer; {number of good chars in buffer}
bptr : integer; {buffer subscript of next char}
fptr : integer4; {dos file pointer (1 origin)}
end {text_file};
var
f : ads of array [0..number_of_lines] of text_file;
crlf : lstring(2);
value
crlf:=cr*lf;
{initialize this file package}
procedure fs_init;
begin
f := far_alloc(sizeof(f^));
end {fs_init};
{open a text file for reading; return 0 or dos error code}
function fs_openr{line : integer; consts s : lstring} {integer};
var
i,n : integer;
label out;
begin
if line<0 or else line>number_of_lines then
[fs_openr:=4; return];
f^[line].ngood:=0;
f^[line].bptr:=ioblen+1;
f^[line].fptr:=1;
q[line].handle:=0;
q[line].dos_err:=0;
for i:=0 to number_of_lines do
if i<>line and then w^[i].file_locked<>nill and then
eq(s,w^[i].file_locked^.msg) and then w^[i].rw=writing then
[q[line].dos_err:=-1; goto out];
n:=xopen(0,s);
if n<0 then
[q[line].dos_err:=-n; goto out];
q[line].handle:=n;
if w^[line].file_locked=nill
then w^[line].file_locked:=newpara(s)
else kopylst(s,w^[line].file_locked^.msg);
w^[line].rw:=reading;
out:
fs_openr:=q[line].dos_err;
end {fs_openr};
{open a text file for writing; return 0 or dos error code}
function fs_openw{line : integer; consts s : lstring} {integer};
var
i,n : integer;
label out;
begin
if line<0 or else line>number_of_lines then
[fs_openw:=4; return];
f^[line].ngood:=-1;
f^[line].bptr:=1;
f^[line].fptr:=1;
q[line].handle:=0;
q[line].dos_err:=0;
for i:=0 to number_of_lines do
if i<>line and then w^[i].file_locked<>nill and then
eq(s,w^[i].file_locked^.msg) then
[q[line].dos_err:=-1; goto out];
n:=xopen(1,s);
if n<0 then
[q[line].dos_err:=-n; goto out];
q[line].handle:=n;
if w^[line].file_locked=nill
then w^[line].file_locked:=newpara(s)
else kopylst(s,w^[line].file_locked^.msg);
w^[line].rw:=writing;
out:
fs_openw:=q[line].dos_err;
end {fs_openw};
{have we reached end of file while reading?}
function fs_eof{line : integer} {boolean};
var
n : integer;
begin
fs_eof:=true;
if line<0 or else line>number_of_lines or else q[line].dos_err<>0 then
return;
if f^[line].bptr>ioblen then begin
n:=xread(q[line].handle,ads f^[line].buffer,ioblen);
if n>=0 then
[f^[line].ngood:=n;
f^[line].fptr:=f^[line].fptr+n;
f^[line].bptr:=1;
q[line].dos_err:=0]
else
[f^[line].ngood:=0;
f^[line].bptr:=1;
q[line].dos_err:=-n];
end {if};
if f^[line].bptr>f^[line].ngood or else
f^[line].buffer[f^[line].bptr]=ctrlz then
return;
fs_eof:=false;
end {fs_eof};
{get the next line from a text file}
function fs_gets{line : integer; vars s : lstring} {integer};
var
i,n : integer;
ch : char;
begin
s.len:=0;
if line<0 or else line>number_of_lines then
[fs_gets:=4; return];
i:=0;
while true do begin
if f^[line].bptr>ioblen then begin
n:=xread(q[line].handle,ads f^[line].buffer,ioblen);
if n>=0 then
[f^[line].ngood:=n;
f^[line].fptr:=f^[line].fptr+n;
f^[line].bptr:=1;
q[line].dos_err:=0]
else
[f^[line].ngood:=0;
f^[line].bptr:=1;
q[line].dos_err:=-n;
break];
end {if};
if f^[line].bptr>f^[line].ngood then break; {missing crlf at eof}
ch:=f^[line].buffer[f^[line].bptr];
f^[line].bptr:=f^[line].bptr+1;
if ch=cr then cycle;
if ch=lf then break;
if i<UPPER(s) then
[i:=i+1; s[i]:=ch; s.len:=wrd(i)];
end {while};
fs_gets:=q[line].dos_err;
end {fs_gets};
function fs_puts{line : integer; consts s : lstring} {integer};
var
i,n : integer;
ch : char;
begin
if line<0 or else line>number_of_lines then
[fs_puts:=4; return];
f^[line].ngood:=-1; {we're writing}
i:=1;
while i<=ord(s.len)+2 do begin
if f^[line].bptr>ioblen then begin
n:=xwrite(q[line].handle,ads f^[line].buffer,ioblen);
if n>=0 then
[f^[line].fptr:=f^[line].fptr+n;
f^[line].bptr:=1;
q[line].dos_err:=0]
else
[q[line].dos_err:=-n;
break];
end {if};
if i<=ord(s.len) then
ch:=s[i]
else if i=ord(s.len)+1 then
ch:=cr
else
ch:=lf;
f^[line].buffer[f^[line].bptr]:=ch;
f^[line].bptr:=f^[line].bptr+1;
i:=i+1;
end {while};
fs_puts:=q[line].dos_err;
end {fs_puts};
procedure fs_close{line : integer};
var
n : integer;
begin
if line<0 or else line>number_of_lines then return;
if f^[line].ngood=-1 and then f^[line].bptr>1 then begin
n:=xwrite(q[line].handle,ads f^[line].buffer,wrd(f^[line].bptr-1));
if n>=0 then
[f^[line].fptr:=f^[line].fptr+n;
f^[line].bptr:=1;
q[line].dos_err:=0]
else
q[line].dos_err:=-n;
end {if};
if q[line].handle>0 then
mail_close(q[line].handle);
q[line].handle := 0;
if w^[line].file_locked<>nill then w^[line].file_locked^.msg:=null;
end {fs_close};
END.